﻿'*****************************************************************************
' Project : wpListSincMapper            Version: 1.0.0
' Description: Sharepoint List Sincronizer Web Part, mapping based.
' Authors: Roberto Marcos Asensio, Guillermo Martin Royo
' Release Date : 21-6-2009
' Support Blog: http://sharepointworks.blogspot.com
' Author Web Page : http://www.robertomarcos.com
' CodePlex Web site. http://spListSincMapper.codeplex.com
' License : This project is unde GPL license
'*****************************************************************************




Option Explicit On
Option Strict Off

Imports System
Imports System.Runtime.InteropServices
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Xml.Serialization

Imports Microsoft.SharePoint
Imports Microsoft.SharePoint.WebControls
Imports Microsoft.SharePoint.WebPartPages

Imports System.Xml
Imports System.Xml.XPath

Imports System.Data
Imports System.Diagnostics
Imports Microsoft.VisualBasic

Imports System.Collections.Generic
Imports System.ComponentModel
Imports Microsoft.SharePoint.Utilities
Imports MiscTools

Imports ADODB

Imports System.Net
Imports System.IO
Imports System.Text
Imports System.Timers
Imports System.Web


Namespace wpListSincMapper

    <Guid("a7563c2e-6f5b-4336-8ef9-028a13d1c905")> _
    Public Class wpListSincMapper
        Inherits System.Web.UI.WebControls.WebParts.WebPart
        Private _UserControl As String = "~/_controltemplates/wpListSincMapper.ascx"
        Dim _Control As Control
        Dim WithEvents boton1 As New Microsoft.SharePoint.WebControls.FormButton
        Dim WithEvents sincronizarXML As New Microsoft.SharePoint.WebControls.FormButton
        Dim mensaje As New LiteralControl()
        Dim cursite As SPWeb = SPControl.GetContextWeb(Context)

        'NUEVO XML
        Dim nav As XPathNavigator
        Dim docNav As XPathDocument


        'FINALIDAD DE LA WEBPART: RECORRER LAS LISTAS QUE EXISTEN EN EL SP-SITE ACTUAL EN EL QUE SE INCLUYA 
        'ESTA WEBPART Y GUARDAR NUEVOS REGISTROS DE LAS LISTAS, ASI COMO SUS CARACTERÍSTICAS O MODIFICARLOS 
        'SI YA EXISTEN Y HAN CAMBIADO. POSTERIORMENTE SE PUEDEN VISIONAR EN UN FORMULARIO HECHO EN EL SP-DESIGNER. 

        Protected Overrides Sub CreateChildControls()
            MyBase.CreateChildControls()
            boton1.Text = "Cargar Listas"
            boton1.ControlMode = SPControlMode.Display
            sincronizarXML.Text = "Realizar sincronizado"
            sincronizarXML.ControlMode = SPControlMode.Display
            'Call CreaXMLSiNoExiste()

            Try
                Me.Controls.Add(boton1)
                Me.Controls.Add(mensaje)
                Me.Controls.Add(sincronizarXML)

                _Control = TryCast(Me.Page.LoadControl(_UserControl), UserControl)
                '    '_Control = Me.Page.LoadControl(_UserControl)
            Catch ex As Exception
                _Control = New LiteralControl(String.Format("Ajuste el parametro de UserControl, <a href=""javascript:MSOTlPn_ShowToolPaneWrapper('{0}','{1}','{2}');"">Abrir edición de Propiedades de WebPart</a> y escribir la ruta al webcontrol (*.ascx)<br>" & ex.Message, 1, 129, Me.ID))
            End Try


            If Not _Control Is Nothing Then
                Me.Controls.Add(_Control)
            End If

        End Sub

        Private Sub boton1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles boton1.Click
            Call RecorreListas()
            'Call PMeter()
        End Sub


        Private Sub PMeter()
            'PRUEBA DE INSERCIONES

            cursite.AllowUnsafeUpdates = True
            cursite.Update()

            Dim mylist As SPList = cursite.Lists("Costes")

            Dim nuevo As SPListItem = mylist.Items.Add

            nuevo("ID_CENTRO_COSTE") = "Hola"
            nuevo("CENTRO_COSTE") = "prueba"

            nuevo.Update()

        End Sub

        'FUNCION TIPO DE REFERENCIA, ¡AQUI NO SE LLAMA!
        Private Function GetXMLofLISTS() As XmlDocument
            Dim Doc As New XmlDocument
            Dim lst As XmlElement
            Dim campo As XmlElement

            Dim root As SPWeb = SPControl.GetContextWeb(Context)
            If root Is Nothing Then
                Throw New Exception("Could not find SharePoint!")
            End If

            Dim curSite As SPWeb = SPContext.Current.Web


            Dim listCollection As SPListCollection = curSite.Lists
            Dim siteCollection As SPWebCollection = curSite.Webs


            Dim col As New Collection

            Dim i As Integer = 0


            While i < (listCollection.Count - 1) OrElse i < (siteCollection.Count - 1)
                Dim list As SPList = Nothing
                Dim listItem As SPListItem
                Dim atri As SPField
                Dim site As SPWeb = Nothing
                Dim field As SPField = Nothing

                If listCollection.Count > i Then
                    list = listCollection(i)

                    If Not list.Title.ToString = "fpdatasources" Then
                        lst = Doc.CreateElement("Lista")
                        lst.SetAttribute("SPListName", list.Title.ToString)
                        Doc.DocumentElement.AppendChild(lst)

                        For Each listItem In list.Items
                            For Each atri In listItem.Fields
                                campo = Doc.CreateElement("campo")
                                campo.SetAttribute("SPName", atri.Title.ToString)
                                campo.SetAttribute("type", atri.TypeAsString)
                                campo.SetAttribute("length", atri.DisplaySize.ToString)

                                lst.AppendChild(campo)
                                campo = Nothing
                            Next


                        Next
                        Doc.DocumentElement.AppendChild(lst)
                        lst = Nothing
                    End If


                    curSite.AllowUnsafeUpdates = True
                    MiscTools.crea_fichero_Sharepoint(curSite, Replace(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListMappingConfig.xml", "//", "/"), Doc.OuterXml, True) 'Cargador.xml

                End If

                i += 1
            End While

            Return Doc
        End Function


        Private Sub RecorreListas()

            Dim Doc As New XmlDocument
            Dim lst As XmlElement
            Dim campo As XmlElement
            Dim listas As XmlNode, campos As XmlNode

            Dim root As SPWeb = SPControl.GetContextWeb(Context)
            If root Is Nothing Then
                Throw New Exception("Could not find SharePoint!")
            End If

            Dim curSite As SPWeb = SPContext.Current.Web


            Dim listCollection As SPListCollection = curSite.Lists
            Dim siteCollection As SPWebCollection = curSite.Webs


            Dim col As New Collection

            Dim i As Integer = 0  ' Contador para recorrer las listas de sharepoint

            'Verifcar que el fichero XML existe
            Doc = cargaXML()

            'SI NO EXISTE
            If Doc Is Nothing Then

                '   Genero el XML de las listas SI (NO SIEMPRE) el XML no EXISTE (SE VALIDA CON UNA FUNCION)
                ' ESTE XML SE GENERA EN UNA FUNCION
                Doc = CreaXMLSiNoExiste()
                ' Y Lo guardo en un fichero verificando que luego se lee correctamente (HACER TEST EJECUTAR 2 VECES)
                curSite.AllowUnsafeUpdates = True
                MiscTools.crea_fichero_Sharepoint(curSite, Replace(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListMappingConfig.xml", "//", "/"), Doc.OuterXml, True)  'CargaListSP2

                Doc = CreaXMLSiNoExiste()
            End If
            'SI EXISTE LO CARGO para actualizarlo mas adelante


            'RECORRO LAS LISTAS DEL SITIO  DEL CONTEXTO
            While i < (listCollection.Count) OrElse i < (siteCollection.Count)
                Dim list As SPList = Nothing
                'Dim listItem As SPListItem
                Dim atri As SPField
                Dim site As SPWeb = Nothing
                Dim field As SPField = Nothing

                If listCollection.Count >= i Then
                    list = listCollection(i)

                    If list.Title.ToString = "fpdatasources" Or list.Title.ToString = "Custom workflow process" Or list.Title.ToString = "Master Page Gallery" Or list.Title.ToString = "" Then

                        lst = Nothing
                    Else

                        '   BUSCO LA LISTA POR XPATH
                        Try

                            listas = Doc.SelectSingleNode("/Listas/Lista[@SPListName='" + list.Title + "']")

                            lst = listas

                            lst.Attributes("SPListName").Value = list.Title.ToString
                            ' SI NO EXISTE LA LISTA  LA CREO CON DATOS ACTUALES y continuo PERO NO TENDRA CAMPOS
                        Catch ex As Exception

                            lst = Doc.CreateElement("Lista")
                            lst.SetAttribute("SPListName", list.Title)
                            lst.SetAttribute("DBName", "")
                            lst.SetAttribute("sincronizar", "False")
                            lst.SetAttribute("connectionstring", "")

                            lst.Attributes("SPListName").Value = list.Title.ToString

                            Doc.DocumentElement.AppendChild(lst)

                        End Try
                        ' SI EXISTE (si tengo resultados=1) LA ACTUALIZO (nivel lista)

                        '   RECORRO LOS CAMPOS DE LA LISTA SP
                        For Each atri In list.Fields

                            '   RECUPERO EL CAMPO DEL XML POR XPATH /LISTAS/LISTA[@nombre='nombrelistasp']/Campo[@nombrecampo='nombrecamposp']
                            Try

                                campos = Doc.SelectSingleNode("/Listas/Lista[@SPListName='" + list.Title + "']/campo[@SPName='" + atri.Title + "']")

                                ' SI ENCUENTRO EL CAMPO ACTUALIZO LOS DATOS SI SON DIFERENTES, TIPOS DE CAMPO (NOMBRE, LONGITUD,ETC)

                                If campos.Attributes("SPName").Value <> atri.Title.ToString Then
                                    campos.Attributes("SPName").Value = atri.Title.ToString
                                    'campos.Attributes("SPName").Value.Replace(campos.Attributes("SPName").Value.ToString, atri.Title.ToString)
                                End If

                                If campos.Attributes("type").Value <> atri.Type.ToString Then
                                    'Da una Exception con los campos de tipo text (entre Microsoft.SharePoint.SPTextField y los tipo text normales)
                                    campos.Attributes("type").Value = atri.Type.ToString
                                    'campos.Attributes("type").Value.Replace(campos.Attributes("type").Value.ToString, atri.GetType.ToString)
                                End If


                                'Dim valorLongitudExistente As String = ""

                                If atri.Type = SPFieldType.Text Or atri.TypeAsString = "Text" Then

                                    'valorLongitudExistente = DirectCast(atri, Microsoft.SharePoint.SPFieldText).DisplaySize
                                    Dim lengthXML As String = ""
                                    Dim lengthSP As String = ""

                                    lengthXML = campos.Attributes("length").Value.ToString
                                    lengthSP = DirectCast(atri, Microsoft.SharePoint.SPFieldText).MaxLength

                                    If lengthXML = "" Then
                                        lengthXML = Nothing
                                    End If


                                    If lengthXML <> lengthSP Then  'valorLongitudExistente.ToString
                                        campos.Attributes("length").Value = lengthSP 'valorLongitudExistente.ToString
                                        'campos.Attributes("length").Value.Replace(campos.Attributes("length").Value.ToString, atri.DisplaySize) 'valorLongitudExistente
                                    End If
                                Else

                                    campos.Attributes("length").Value = ""
                                    'campos.Attributes("length").Value.Replace(campos.Attributes("length").Value.ToString, "")

                                End If


                            Catch ex As Exception
                                ' SI NO ENCUENTRO EL CAMPO LO AÑADO CON LAS PROPIEDADES, TENGO QUE METER LAS PROPIEDADES (QUE SIRVEN PARA EL VINCULO A mysql) VACIAS PORQUE LUEGO SINO FALLA LA EDICION web
                                campo = Doc.CreateElement("campo")
                                campo.SetAttribute("SPName", atri.Title)
                                campo.SetAttribute("type", atri.TypeAsString)
                                campo.SetAttribute("DBFieldName", "")
                                campo.SetAttribute("PK", "")

                                Dim valorLongitudNuevo As String = ""

                                If atri.Type = SPFieldType.Text Then
                                    valorLongitudNuevo = DirectCast(atri, Microsoft.SharePoint.SPFieldText).MaxLength.ToString

                                    campo.SetAttribute("length", valorLongitudNuevo.ToString)
                                Else
                                    campo.SetAttribute("length", "")
                                End If

                                lst.AppendChild(campo)
                                campo = Nothing

                            End Try
                        Next

                        'GUARDO
                        curSite.AllowUnsafeUpdates = True
                        MiscTools.crea_fichero_Sharepoint(curSite, Replace(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListMappingConfig.xml", "//", "/"), Doc.OuterXml, True) 'CargaListSP2

                        lst = Nothing
                    End If
                End If
                i += 1
            End While
            Call cargaXML()
        End Sub


        Private Function cargaXML() As XmlDocument
            Dim docNav As XmlDocument = Nothing
            Dim de As New KeyValuePair(Of String, Dictionary(Of String, String))()
            Dim strXml As String

            Try
                strXml = SPControl.GetContextWeb(Context).GetFileAsString(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListMappingConfig.xml")

                docNav = New XmlDocument()

                docNav.LoadXml(strXml)


            Catch ex As Exception
                Call CreaXMLSiNoExiste()
            End Try
            Return docNav
        End Function


        Private Function CreaXMLSiNoExiste() As XmlDocument
            Dim doc As New XmlDocument
            Const sXML_Listas As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
        "<Listas>" & _
        "<Lista SPListName="""" DBName="""" sincronizar=""False"" connectionstring="""">" & _
        "   <campo SPName="""" PK="""" type="""" length="""" DBFieldName="""" />" & _
        "</Lista>" & _
        "</Listas>"

            Dim ws As SPWeb = SPControl.GetContextWeb(Context)

            ws.AllowUnsafeUpdates = True
            MiscTools.crea_fichero_Sharepoint(ws, Replace(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListMappingConfig.xml", "//", "/"), sXML_Listas, True)


            Dim strXml As String = SPControl.GetContextWeb(Context).GetFileAsString(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListMappingConfig.xml")

            doc.LoadXml(strXml)

            Return doc
        End Function



        <WebBrowsable(True), Personalizable(PersonalizationScope.User), _
        WebDisplayName("User Control (*.ascx)"), _
        FriendlyName("User Control (*.ascx)"), Category("User Control"), _
        WebDescription("Ruta a un control de Usuario (*.ascx)")> _
        Public Property UserControl() As String
            Get
                Return _UserControl

            End Get
            Set(ByVal value As String)
                _UserControl = value
            End Set
        End Property



        Private Sub sincronizarXML_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles sincronizarXML.Click
            Try

                Dim db As ADODB.Connection
                Dim rs As ADODB.Recordset


                Dim Doc As New XmlDocument

                Doc = cargaXML()


                Dim lstXML As XmlNode ', campoXML As XmlNode = Nothing
                Dim listasXML As XmlNodeList, camposXML As XmlNodeList

                Dim curSite As SPWeb = SPContext.Current.Web
                Dim listCollection As SPListCollection = curSite.Lists
                Dim siteCollection As SPWebCollection = curSite.Webs

                Dim recorrido As Integer = 1

                listasXML = Doc.SelectNodes("/Listas/Lista[@sincronizar=""True""]")
                For Each lstXML In listasXML
                    'NOS SITUAMOS EN LA LISTA A RECORRER (DEL XML) Y COMPROBAMOS SI ES SINCRONIZABLE
                    If lstXML.Attributes("sincronizar").Value = "True" Then

                        'SI LO ES, EJECUTAMOS LA CONEXION CORRESPONDIENTE
                        If lstXML.Attributes("connectionstring").Value = "" Then
                            mensaje.Text = "Incluir datos de 'connectionstring'."
                        Else
                            Dim conexion As String = ""

                            conexion = lstXML.Attributes("connectionstring").Value.ToString

                            db = New Connection
                            db.ConnectionString = conexion
                            db.Open()

                        End If

                        '    'INSERTAR AQUI LOS VALORES RECOGIDOS DEL RS
                        '    'QUE TIENE LOS DATOS QUE QUEREMOS, E IRLOS INSERTANDO EN LA SPLIST QUE CORRESPONDA
                        '    'JUNTO AL VALOR DEL CAMPO QUE CORRESPONDA (UNO A UNO CON TIPO "TmpSPList.Update()")


                        '--------------------------CONSTRUIMOS LA SELECT-------------------------------------------------------------------
                        Dim nombreLista As String = ""
                        Dim listaSP As SPList
                        ''Dim elementoSP As SPListItem

                        nombreLista = lstXML.Attributes("SPListName").Value.ToString()
                        listaSP = listCollection.Item(nombreLista)

                        camposXML = lstXML.ChildNodes


                        Dim tabla As String = ""  ' Esta es la tabla o query que nos da los datos

                        If lstXML.Attributes("query").Value.ToString() <> "" Then
                            tabla = "(" & lstXML.Attributes("query").Value.ToString() & ")"
                        Else
                            tabla = lstXML.Attributes("DBName").Value.ToString
                        End If


                        Dim i As Integer
                        Dim sqlCampos As String = ""
                        Dim campoclave As String = ""
                        Dim campoclavesp As String = ""
                        Dim indice As Integer

                        For i = 0 To camposXML.Count - 1
                            Dim tmpcampoXML As String = camposXML(i).Attributes("DBFieldName").Value.ToString()
                            If tmpcampoXML <> String.Empty Then
                                If sqlCampos <> String.Empty Then sqlCampos = sqlCampos & ","

                                sqlCampos = sqlCampos & "[" & camposXML(i).Attributes("DBFieldName").Value.ToString() & "] AS [" & camposXML(i).Attributes("SPName").Value.ToString() & "]"

                                'MODIFICACION PARA ASIGNAR A LOS camposclave EL VALOR DE LOS QUE ESTEN MARCADOS EN EL XML COMO PK=TRUE 
                                If camposXML(i).Attributes("PK").Value = True Then


                                    If campoclave = String.Empty Then
                                        campoclave = camposXML(i).Attributes("DBFieldName").Value.ToString()
                                        indice = i
                                        campoclavesp = camposXML(i).Attributes("SPName").Value.ToString()
                                    End If


                                End If
                            End If
                        Next
                        '----------------------------ABRIMOS EL RECORDSET CON TODOS LOS CAMPOS A MAPEAR-----------------------------------------------------------------
                        If sqlCampos <> "" Then
                            rs = New Recordset

                            rs.Open("Select " & sqlCampos & " from " & tabla & " tmp ", db, CursorTypeEnum.adOpenStatic, LockTypeEnum.adLockPessimistic)

                            curSite.AllowUnsafeUpdates = True
                            curSite.Update()

                            Dim encontrados As String = ""

                            Dim fld As ADODB.Field

                            Dim SPitem As SPListItem
                            For Each SPitem In listaSP.Items


                                Try
                                    rs.Find(rs.Fields(indice).Name & "='" & SPitem(rs.Fields(indice).Name) & "'")
                                    If Not rs.EOF Then  ' Significa que no lo encuentra
                                        Dim tmpEnc As String
                                        If IsArray(rs.Fields(indice).Value) Then
                                            tmpEnc = (New System.Text.ASCIIEncoding).GetString(rs.Fields(indice).Value)
                                        Else
                                            tmpEnc = rs.Fields(indice).Value
                                        End If


                                        If encontrados <> String.Empty Then encontrados = encontrados & ","
                                        encontrados = encontrados & "'" & tmpEnc & "'"

                                        ' Se actualizan todos los campos del elemento de la lista sharepoint
                                        For Each fld In rs.Fields
                                            If IsArray(fld.Value) Then
                                                SPitem(fld.Name) = (New System.Text.ASCIIEncoding).GetString(fld.Value)
                                            Else
                                                SPitem(fld.Name) = fld.Value
                                            End If

                                        Next
                                        SPitem.Update()
                                    Else
                                        If encontrados <> String.Empty Then encontrados = encontrados & ""
                                    End If
                                Catch ex As Exception

                                    'Dim tmpEnc As String = rs.Fields(0).Value

                                    'If rs.EOF Then 'no lo ha encontrado
                                    ' No se hace nada CASO "A"

                                    If encontrados <> String.Empty Then encontrados = encontrados & ""

                                End Try
                            Next



                            ' Como el filter no funciona pues lo hacemos tirando otra consultita
                            Dim sqlFiltrado As String
                            If encontrados = String.Empty Then
                                sqlFiltrado = "Select distinct " & sqlCampos & " from " & tabla & " tmp "
                            Else
                                sqlFiltrado = "Select distinct " & sqlCampos & " from " & tabla & " tmp WHERE [" & campoclave & "] not IN (" & encontrados & ")"
                            End If
                            rs = db.Execute(sqlFiltrado)

                            While Not rs.EOF   ' Recorremos registro a registro del recordset
                                'Aqui hay que verificar que no existe
                                Dim nuevo = listaSP.Items.Add
                                'si existe se recupera y se actualiza

                                For Each fld In rs.Fields
                                    If IsArray(fld.Value) Then
                                        nuevo(fld.Name) = (New System.Text.ASCIIEncoding).GetString(fld.Value)
                                    Else
                                        nuevo(fld.Name) = fld.Value
                                    End If
                                Next
                                nuevo.Update()
                                rs.MoveNext()  ' Siguiente registro
                            End While
                            listaSP.Update()

                            ' Vamos a buscar los elementos del sharepoint que ya no estan en la tabla
                            Dim dic As New Dictionary(Of String, SPListItem)
                            For Each SPitem In listaSP.Items
                                dic.Add(SPitem(campoclavesp), SPitem)
                            Next

                            sqlFiltrado = "Select distinct " & sqlCampos & " from " & tabla & " tmp "
                            rs = db.Execute(sqlFiltrado)

                            While Not rs.EOF

                                If IsArray(rs(campoclavesp).Value) Then
                                    If dic.ContainsKey((New System.Text.ASCIIEncoding).GetString(rs(campoclavesp).Value)) Then
                                        dic.Remove((New System.Text.ASCIIEncoding).GetString(rs(campoclavesp).Value))
                                    End If

                                Else
                                    If dic.ContainsKey(rs(campoclavesp).Value) Then
                                        dic.Remove(rs(campoclavesp).Value)
                                    End If
                                End If
                                rs.MoveNext()
                            End While


                            For Each SPitem In dic.Values
                                SPitem.Delete()
                            Next
                            listaSP.Update()


 
                        End If

                    End If
                    lstXML = Nothing
                    If rs.EOF = True Then
                        rs.Close()
                    End If

                Next lstXML
            Catch ex As Exception
                Me.Controls.Add(New LiteralControl(String.Format("Error en el webpart.<br>" & ex.Message, 1, 129, Me.ID)))
            End Try

        End Sub
    End Class
End Namespace
